home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / dviware / dvitovdu32 / src / pascal / tek4010vdu.p < prev    next >
Text File  |  1991-11-10  |  11KB  |  325 lines
  1. (* Implements the routines used in VDU-specific modules that emulate
  2.    a Tektronix 4010 terminal (VIS500/550, VT640).
  3.    The screen is assumed to be 780 pixels high by 1024 pixels wide.
  4.    (The actual resolution of an emulating screen may be different, but
  5.    such terminals provide automatic scaling.)
  6.    The bottom left pixel is the point (x=0,y=0); x coordinates
  7.    increase to the right and y coordinates increase up the screen.
  8.    DVItoVDU uses a coordinate scheme in which horizontal (=h) coordinates
  9.    also increase to the right but vertical (=v) coordinates increase DOWN the
  10.    screen, i.e. the top left pixel on the screen is the point (h=0,v=0).
  11.    This means that the Tektronix 4010 routines will have to do a
  12.    simple translation of the vertical coordinates passed by DVItoVDU.
  13. *)
  14.  
  15. #include 'globals.h';
  16. #include 'screenio.h';
  17. #include 'tek4010vdu.h';
  18.  
  19. VAR
  20.    oldhiy,                 (* for remembering old address in SendXY *)
  21.    oldhix,
  22.    oldloy : INTEGER;
  23.    charwidth,              (* set by LoadFont and used in ShowChar *)
  24.    loadedsize,             (* remember alpha size set by last LoadFont; VT640,
  25.                               VIS500/550 VDUs don't actually need to worry
  26.                               about this since they use non-TEK4010 fonts to
  27.                               draw in dialogue region.
  28.                               VIS240 however uses alpha mode font. *)
  29.    charsize : INTEGER;     (* used to select alpha character size *)
  30.  
  31. (******************************************************************************)
  32.  
  33. PROCEDURE SendXY (x, y : INTEGER);
  34.  
  35. (* Translates the given screen address into 4 bytes.
  36.    havesentxy is used to minimize the number of bytes sent: after the first
  37.    4 bytes have been sent, subsequent bytes that don't change need not be sent
  38.    (except for the low x byte which is always sent).
  39.    If the high x byte changes then the low y byte must also be sent.
  40. *)
  41.  
  42. VAR hiy, loy, hix, lox : INTEGER;
  43.     sendhix : BOOLEAN;
  44.  
  45. BEGIN
  46. (* we assume y is in [0..maxy] and x is in [0..1023] *)
  47. hiy := ORD(' ') + (y DIV 32);
  48. hix := ORD(' ') + (x DIV 32);
  49. loy := ORD('`') + (y MOD 32);
  50. lox := ORD('@') + (x MOD 32);
  51. IF havesentxy THEN BEGIN
  52.    IF hiy <> oldhiy THEN BEGIN
  53.       WriteChar(CHR(hiy));   oldhiy := hiy;
  54.    END;
  55.    sendhix := hix <> oldhix;
  56.    IF (loy <> oldloy) OR sendhix THEN BEGIN
  57.       WriteChar(CHR(loy));   oldloy := loy;
  58.    END;
  59.    IF sendhix THEN BEGIN
  60.       WriteChar(CHR(hix));   oldhix := hix;
  61.    END;
  62.    WriteChar(CHR(lox));
  63. END
  64. ELSE BEGIN  (* send first 4 bytes *)
  65.    WriteChar(CHR(hiy));   oldhiy := hiy;
  66.    WriteChar(CHR(loy));   oldloy := loy;
  67.    WriteChar(CHR(hix));   oldhix := hix;
  68.    WriteChar(CHR(lox));
  69.    havesentxy := TRUE;
  70. END;
  71. (* SYSDEP: We assume XON/XOFF flow control is enabled to avoid data loss. *)
  72. END; (* SendXY *)
  73.  
  74. (******************************************************************************)
  75.  
  76. PROCEDURE TEK4010StartText;
  77.  
  78. BEGIN
  79. WriteChar(US);
  80. END; (* TEK4010StartText *)
  81.  
  82. (******************************************************************************)
  83.  
  84. PROCEDURE TEK4010MoveToTextLine (line : INTEGER);
  85.  
  86. (* Move cursor to start of given line using lineht.
  87.    At the end of this routine we must be in alpha mode and ready to display
  88.    characters in the default charsize.
  89. *)
  90.  
  91. BEGIN
  92. WriteChar(GS);                          (* switch to graphics mode *)
  93. SendXY(0,maxy+1 - (line*lineht));
  94. WriteChar(ESC);                         (* reset alpha character size *)
  95. WriteChar('0');
  96. charsize := 0;
  97. charwidth := 13;
  98. WriteChar(US);                          (* back to alpha mode *)
  99. END; (* TEK4010MoveToTextLine *)
  100.  
  101. (******************************************************************************)
  102.  
  103. PROCEDURE TEK4010ClearScreen;
  104.  
  105. BEGIN
  106. WriteChar(GS);                    (* make sure we're in graphics mode *)
  107. WriteChar(ESC); WriteChar(FF);    (* erase graphics and put in alpha mode *)
  108. havesentxy := FALSE;              (* ESC FF will home cursor *)
  109. charsize := 0;                    (* ESC FF resets character size *)
  110. charwidth := 13;
  111. END; (* TEK4010ClearScreen *)
  112.  
  113. (******************************************************************************)
  114.  
  115. PROCEDURE TEK4010StartGraphics;
  116.  
  117. BEGIN
  118. IF charsize <> loadedsize THEN BEGIN   (* graphics mode was interrupted *)
  119.    charsize := loadedsize;
  120.    dragdown := (charsize + 1) * 5;     (* used by VIS500/550 ShowChar *)
  121.    WriteChar(GS);
  122.    WriteChar(ESC);
  123.    WriteChar(CHR(ORD('0')+charsize));  (* recall last LoadFont character size *)
  124. END;
  125. WriteChar(GS);
  126. havesentxy := FALSE;                   (* safer to send all bytes anew *)
  127. END; (* TEK4010StartGraphics *)
  128.  
  129. (******************************************************************************)
  130.  
  131. PROCEDURE TEK4010LoadFont (fontname : string;
  132.                            fontsize : INTEGER;
  133.                            mag, hscale, vscale : REAL);
  134.  
  135. (* Use the given fontsize to select an appropriate character size
  136.    (based on horizontal scaling only!) for future ShowChar calls.
  137. *)
  138.  
  139. VAR newsize : INTEGER;
  140.  
  141. BEGIN
  142. (* convert fontsize into scaled screen pixels using mag and hscale *)
  143. fontsize := TRUNC( (fontsize * mag * hscale) + 0.5 );
  144. (* Chooose one of the 4 alpha mode character sizes based on fontsize:
  145.    charsize    max chars/line    relative size     fontsize range
  146.        0             80               x1               0..40
  147.        1             40               x2              41..80
  148.        2             26               x3              81..120
  149.        3             20               x4             121...
  150.    The fontsize ranges were chosen by trial and error.
  151. *)
  152. IF    fontsize < 41 THEN BEGIN
  153.    newsize := 0;
  154.    charwidth := 13;   (* 1024/80 = 12.8 *)
  155. END
  156. ELSE IF fontsize < 81 THEN BEGIN
  157.    newsize := 1;
  158.    charwidth := 26;   (* 1024/40 = 25.6 *)
  159. END
  160. ELSE IF fontsize < 121 THEN BEGIN
  161.    newsize := 2;
  162.    charwidth := 40;   (* 1024/26 = 39.4 *)
  163. END
  164. ELSE BEGIN
  165.    newsize := 3;
  166.    charwidth := 52;   (* 1024/20 = 51.2 *)
  167. END;
  168. loadedsize := newsize;   (* remember in case graphics mode is interrupted *)
  169. IF charsize <> newsize THEN BEGIN   (* change character size *)
  170.    charsize := newsize;
  171.    WriteChar(ESC);
  172.    WriteChar(CHR(ORD('0')+charsize));
  173. END;
  174. (* Alpha character reference pts on some emulating VDUs (VIS500/550) are below
  175.    baselines to allow for descenders.
  176.    Such VDUs can use dragdown to drag baselines down to TeX reference pts
  177.    when calling ShowChar.
  178. *)
  179. dragdown := (charsize + 1) * 5;       (* used by VIS500/550 ShowChar *)
  180. WriteChar(GS);                        (* must exit in graphics mode *)
  181. END; (* TEK4010LoadFont *)
  182.  
  183. (******************************************************************************)
  184.  
  185. PROCEDURE TEK4010ShowChar (screenh, screenv : INTEGER;
  186.                            ch : CHAR);
  187.  
  188. (* Show the given Terse character (mapped to ASCII) at the given ref pt.
  189.    We use the charwidth set by last LoadFont call.
  190. *)
  191.  
  192. VAR newch : CHAR;   (* = TeXtoASCII[ch] *)
  193.  
  194. BEGIN
  195. (* shift character left if it will overlap right edge of screen *)
  196. IF screenh + charwidth > 1023 THEN
  197.    screenh := 1023 - charwidth;
  198. (* we assume StartGraphics, LoadFont or last ShowChar has just sent GS *)
  199. SendXY(screenh,maxy-screenv);    (* move cursor to ref pt *)
  200.  
  201. (* We use TeXtoASCII to map ch into a comparable ASCII character, apart
  202.    from most of the ? characters which we attempt to simulate.
  203. *)
  204.  
  205. WriteChar(US);   (* enter alpha mode *)
  206. newch := TeXtoASCII[ch];
  207. IF newch <> '?' THEN
  208.    (* newch is similar to TeX ch *)
  209.    WriteChar(newch)
  210. ELSE
  211.    (* attempt to display something other than ? *)
  212.    CASE ORD(ch) OF
  213.    13b..17b :   (* ff, fi, fl, ffi, ffl *)
  214.        BEGIN
  215.        WriteChar('f');
  216.        (* only simulate rest of ligature if room at right edge *)
  217.        IF screenh + 2 * charwidth - (charwidth DIV 2) <= 1023 THEN BEGIN
  218.           WriteChar(GS);
  219.           SendXY(screenh + charwidth - (charwidth DIV 2),maxy-screenv);
  220.           WriteChar(US);
  221.           CASE ORD(ch) OF
  222.           13b : WriteChar('f') ;
  223.           14b : WriteChar('i') ;
  224.           15b : WriteChar('l') ;
  225.           16b,
  226.           17b : BEGIN
  227.                 WriteChar('f');
  228.                 IF screenh + 3 * charwidth - 2 * (charwidth DIV 2) <= 1023 THEN
  229.                    BEGIN
  230.                    WriteChar(GS);
  231.                    SendXY(screenh + 2 * charwidth - 2 * (charwidth DIV 2),
  232.                           maxy-screenv);
  233.                    WriteChar(US);
  234.                    IF ch = CHR(16b) THEN
  235.                       WriteChar('i')
  236.                    ELSE
  237.                       WriteChar('l');
  238.                 END;
  239.                 END;
  240.           END;
  241.        END;
  242.        END;
  243.    31b : WriteChar('B');   (* German sharp S *)
  244.    32b, 33b, 35b, 36b :    (* diphthongs: ae, oe, AE, OE *)
  245.        BEGIN
  246.        CASE ORD(ch) OF
  247.        32b : WriteChar('a') ;
  248.        33b : WriteChar('o') ;
  249.        35b : WriteChar('A') ;
  250.        36b : WriteChar('O')
  251.        END;
  252.        IF screenh + 2 * charwidth - (charwidth DIV 2) <= 1023 THEN BEGIN
  253.           WriteChar(GS);
  254.           SendXY(screenh + charwidth - (charwidth DIV 2),maxy-screenv);
  255.           WriteChar(US);
  256.           CASE ORD(ch) OF
  257.           32b, 33b : WriteChar('e') ;
  258.           35b, 36b : WriteChar('E')
  259.           END;
  260.        END;
  261.        END;
  262.    34b, 37b :   (* Scandinavian slashed o and O *)
  263.        BEGIN
  264.        CASE ORD(ch) OF
  265.        34b : WriteChar('o') ;
  266.        37b : WriteChar('O')
  267.        END;
  268.        WriteChar(GS);
  269.        SendXY(screenh,maxy-screenv);   (* overwrite *)
  270.        WriteChar(US);
  271.        WriteChar('/');
  272.        END;
  273.    40b : WriteChar('''');              (* Polish suppressed l and L *)
  274.    OTHERWISE
  275.        WriteChar('?');
  276.    END;
  277. WriteChar(GS);                         (* must exit in graphics mode *)
  278. END; (* TEK4010ShowChar *)
  279.  
  280. (******************************************************************************)
  281.  
  282. PROCEDURE TEK4010ShowRectangle (screenh, screenv,         (* top left pixel *)
  283.                                 width, height : INTEGER;  (* of rectangle *)
  284.                                 ch : CHAR);               (* black pixel *)
  285.  
  286. (* Display the given rectangle (without using the given black pixel character).
  287.    DVItoVDU ensures that the top left position is visible and that the given
  288.    dimensions do not go beyond the window edges.
  289. *)
  290.  
  291. VAR i, endpt : INTEGER;
  292.  
  293. BEGIN
  294. (* DVItoVDU ensures width and height > 0 *)
  295. IF height < width THEN BEGIN              (* show row vectors *)
  296.    endpt := screenh+width-1;
  297.    FOR i := 0 TO height-1 DO BEGIN
  298.       WriteChar(GS);
  299.       SendXY(screenh,maxy-(screenv+i));   (* move cursor to start of row *)
  300.       SendXY(endpt,maxy-(screenv+i));     (* draw vector to end of row *)
  301.    END;
  302. END
  303. ELSE BEGIN                                (* show column vectors *)
  304.    endpt := maxy - (screenv+height-1);
  305.    FOR i := 0 TO width-1 DO BEGIN
  306.       WriteChar(GS);
  307.       SendXY(screenh+i,maxy-screenv);     (* move cursor to start of column *)
  308.       SendXY(screenh+i,endpt);            (* draw vector to end of column *)
  309.    END;
  310. END;
  311. END; (* TEK4010ShowRectangle *)
  312.  
  313. (******************************************************************************)
  314.  
  315. PROCEDURE InitTEK4010VDU;
  316.  
  317. BEGIN
  318. havesentxy := FALSE;      (* for first SendXY call *)
  319. charsize := 0;            (* the default character size *)
  320. loadedsize := charsize;   (* for first StartGraphics call *)
  321. charwidth := 13;          (* 1024 / 80 = 12.8 *)
  322. maxy := 779;              (* some VDUs may want to change this *)
  323. lineht := 26;             (* 30 text lines; 26 * 30 = 780 *)
  324. END; (* InitTEK4010VDU *)
  325.